Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/DBL Pascal Library/INIT Shell Folder/INIT Shell ƒ/Shell ƒ/INITShellInlines.p

Text File | 1990-05-28 | 10.2 KB | 258 lines | [TEXT/PJMM]

unit INITShellInlines;
{Copyright © 1990, David B. Lamkins}
{All rights reserved.}

interface

{•• This unit contains inline routines which depend upon very particular conventions}
{•• for their proper use.  Many of these routines modify the runtime stack in a way}
{•• which will cause system crashes if not used according to their directions.  Please}
{•• read the comments and accompanying documentation carefully before use…}

{Patches:}
{}
{Register parameters may be accessed and register values returned using the inline functions}
{provided in this unit.  The ability to return register values depends upon THINK Pascal}
{generating a simple UNLK, RTS epilog for procedures.}
{}
{Stack parameters are accessed parasitically by offset, and must never be declared.  The}
{ability to access stack parameters depends upon THINK Pascal always generating a LINK}
{prologue for procedures.}
{}
{Rather than returning to its caller, the patch code may transfer control to a patched routine}
{by using the SetTrapExit inline procedure declared in this unit.  This is the normal and preferred}
{method of handling a trap patch.  The alternative requires you to call the patched routine from}
{within this patch code using the inline CallPatchedTrap procedure, and results in a "tail patch".}
{}
{VBLs:}
{}
{VBLs do not have parameters.  On entry, A0 points to the VBL's own VBLTask record.  You can}
{use GetVBLTask to copy this pointer to a local variable.  Your VBL must set its count to a nonzero}
{value if it is to be requeued.  See II-349 and TN 180 for further details.}

    uses
        INITShellGlobals, Retrace;

{This procedure must be called at most once, and must be called from the main routine, not}
{from a nested routine.  It modifies the return address on the stack to transfer control via}
{a jump to the stashed address of the patch code, rather than returning to the caller.  Control}
{will eventually pass back to the caller when the patched trap returns.  Call this procedure}
{just before exit, as late as possible, and *never* more than once!  The globals access}
{routines (GlobalsHandle, LockGlobals, UnlockGlobals) depend on this not having been called.}
    procedure SetTrapExit;
    inline
        $54AE, $0004;    {ADDQ.L #2,4(A6)}

{This procedure must be called from the main routine, not from a nested routine.  It calls}
{the patched trap via its stashed address.  Note that it preserves all registers.}
    procedure CallPatchedTrap;
    inline
        $42A7,            {CLR.L -(SP)                -- make room for return address}
        $42A7,            {CLR.L -(SP)                -- make room for call address}
        $2F08,            {MOVE.L A0,-(SP)        -- save A0}
        $41FA, $0012,    {LEA $14(PC),A0            -- calculate call return address}
        $2F48, $0008,    {MOVE.L A0,8(SP)        -- stuff return address into stack}
        $206E, $0004,    {MOVEA.L 4(A6),A0        -- get header return}
        $2068, $0004,    {MOVEA.L 4(A0),A0        -- fetch address of trapped patch}
        $2F48, $0004,    {MOVE.L A0,4(SP)        -- tuck into stack}
        $205F,            {MOVEA.L (SP)+,A0        -- restore A0}
        $4E75;            {RTS                        -- make the call}

{This procedure must be called from the main routine, not from a nested routine.  It deallocates}
{the local stack frame, discards the specified number of bytes of parameters, and returns to}
{the patched trap's caller.  This is needed if you want to completely replace the functionality of}
{the original trap with your own code.  The only use I can think of for this is in virus protection}
{software that wants to selectively suppress the action of certain traps.  Be certain that you}
{pass an even value as the parameter - an odd value will misalign the stack and cause a double}
{fault at runtime.}
    procedure DeallocateAndReturn (paramSize: INTEGER);
    inline
        $206E, $0008,    {MOVEA.L 8(A6),A0    -- save original return address}
        $301F,            {MOVE.W (SP)+,D0    -- get param byte size}
        $4E5E,            {UNLK A6                -- discard frame}
        $4FF7, $0008,    {LEA 8(SP,D0.W),SP    -- discard header & caller RA, and params}
        $4ED0;            {JMP (A0)            -- return}

{The following functions are used to access parameters passed in registers.  In order to capture}
{registers passed to a trap, the GetReg__ functions must be called first thing in the patch code,}
{and may only appear in a statement which assigns the value to a local variable of main.}
{This works because the THINK Pascal compiler is good enough not to shuffle values through}
{registers to do an assignment.  The actual code generated looks something like this:}
{    A0 := RegA0;                    -- the Pascal source}
{    ADDQ.L    #4,A7                -- the compiler reserves space for the result}
{    MOVE.L    A0,(A7)            -- the inline code expansion of function RegA0}
{    MOVE.L    (A7)+,-__(A6)    -- the assignment to a local variable}
    function GetRegA0: LONGINT;
    inline
        $2E88;    {MOVE.L A0,(A7)}

    type
        VBLTaskPtr = ^VBLTask;

    function GetVBLTask: VBLTaskPtr;    {an alias for RegA0, to be used in VBLs}
    inline
        $2E88;    {MOVE.L A0,(A7)}

    function GetRegA1: LONGINT;
    inline
        $2E89;    {MOVE.L A1,(A7)}

    function GetRegD0: LONGINT;
    inline
        $2E80;    {MOVE.L D0,(A7)}

    function GetRegD1: LONGINT;
    inline
        $2E81;    {MOVE.L D1,(A7)}

    function GetRegD2: LONGINT;
    inline
        $2E82;    {MOVE.L D2,(A7)}

{The following procedures are used to pass register parameters to a patched trap.  These}
{calls should immediately preceed ExitToTrap or a call to CallPatchedTrap.  As noted above,}
{the THINK Pascal compiler is good enough not to shuffle values through registers, so the}
{order of these calls doesn't matter.}
    procedure SetRegA0 (value: LONGINT);
    inline
        $205F;    {MOVEA.L (A7)+,A0}

    procedure SetRegA1 (value: LONGINT);
    inline
        $225F;    {MOVEA.L (A7)+,A1)}

    procedure SetRegD0 (value: LONGINT);
    inline
        $201F;    {MOVE.L (A7)+,D0}

    procedure SetRegD1 (value: LONGINT);
    inline
        $221F;    {MOVE.L (A7)+,D1}

    procedure SetRegD2 (value: LONGINT);
    inline
        $241F;    {MOVE.L (A7)+,D2}

{The following functions access parameters parasitically.  You need to know the size of}
{each parameter on the stack.  The offset you will pass to the following routines is the}
{sum of the stack size of all the parameters which follow it in the parameter list.  For}
{example, if you are patching the stack trap:}
{    AddResource(h: Handle; rType: ResType; id: INTEGER; name: STR255);}
{you'll use the following expressions to access the parameters of the caller:}
{    h := Handle(LParam(10));}
{    rType := ResType(LParam(6));}
{    id := WParam(4);}
{    namePtr := StringPtr(LParam(0));}
{}
{These procedures depend upon the stack protocol which is determined by the header code.}
{When these procedures are called, the stack will contain (starting "deep" in the stack) the}
{trap's parameters in left-to-right order, the caller's return address, the header's return}
{address, the frame pointer, and any local variables of the patch code.}
{}
{There is one function for each size of parameter which may be pushed: LParam for 4-byte}
{parameters, WParam for 2-bytes, and BParam for 1-byte parameters.  The results will}
{usually have to be typecast.}
{}
{Don't try to be clever and put the parameters in the declaration of main.  Remember that the}
{header code will mess with the stack before your main gets control, and since the standard}
{epilogue code may be subverted by the SetTrapExit procedure, your declaration may break}
{even if you account for the return address as an extra parameter.}
    function LParam (offset: INTEGER): LONGINT;
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $2EB6, $000C;    {MOVE.L 12(A6,D0.W),(A7)}

    function WParam (offset: INTEGER): INTEGER;
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $3EB6, $000C;    {MOVE.W 12(A6,D0.W),(A7)}

    function BParam (offset: INTEGER): Byte;
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $1EB6, $000C;    {MOVE.B 12(A6,D0.W),(A7)}

{The following procedures stuff a result into the stack.  The comments for the parameter}
{access routines, above, apply here as well.}
    procedure LResult (value: LONGINT; offset: INTEGER);
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $2D9F, $000C;    {MOVE.L (A7)+,12(A6,D0.W)}

    procedure WResult (value, offset: INTEGER);
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $3D9F, $000C;    {MOVE.W (A7)+,12(A6,D0.W)}

    procedure BResult (value: Byte; offset: INTEGER);
    inline
        $301F,            {MOVE.W (A7)+,D0}
        $1D9F, $000C;    {MOVE.B (A7)+,12(A6,D0.W)}

{The following procedures are used to push stack arguments prior to tail-calling a}
{patched stack-based trap.  The compiler actually generates the push, the NOP is}
{a placeholder because the compiler expects something after an inline declaration.}
    procedure PushL (value: LONGINT);
    inline
        $4e71;    {NOP}

    procedure PushW (value: INTEGER);
    inline
        $4e71;    {NOP}

    procedure PushB (value: Byte);
    inline
        $4e71;    {NOP}

{The following functions are used to pop a result from the stack after tail-calling a}
{patched stack-based trap.  As above, the NOP is only a placeholder.}
    function PopL: LONGINT;
    inline
        $4E71;    {NOP}

    function PopW: INTEGER;
    inline
        $4E71;    {NOP}

    function PopB: Byte;
    inline
        $4E71;    {NOP}

{The following function fetches the handle to the INIT globals.  This must be called from}
{the main program, since it relies on finding a return address into the code header at 4(A6).}
    function GlobalsHandle: INITGlobalsHandle;
    inline
        $206E, $0004,    {MOVEA.L 4(A6),A0        -- get the address of the return to the header}
        $2EA8, $000A;    {MOVE.L 10(A0),(A7)    -- fetch the globals handle}

{The following procedures are used to lock and unlock the globals handle.  They keep the}
{globals handle locked until UnlockGlobals calls balance LockGlobals calls.  These must be}
{called from the main program, since they rely on finding a return address into the code}
{ header at 4(A6).}
    procedure LockGlobals;
    inline
        $206E, $0004,    {MOVEA.L 4(A6),A0        -- get the address of the return to the header}
        $5268, $0008,    {ADDQ.W #1,8(A0)        -- bump the lock counter up by one}
        $2068, $000A,    {MOVEA.L 10(A0),A0    -- fetch the globals handle}
        $A029;            {_HLock                    -- lock it}

    procedure UnlockGlobals;
    inline
        $206E, $0004,    {MOVEA.L 4(A6),A0        -- get the address of the return to the header}
        $5368, $0008,    {SUBQ.W #1,8(A0)        -- bump the lock counter down by one}
        $6606,            {BNE.S *+8                -- unless unlocks balance locks, skip out}
        $2068, $000A,    {MOVEA.L 10(A0),A0    -- fetch the globals handle}
        $A02A;            {_HUnlock                    -- really unlock it}

{Finally, because I don't always get it right the first time…}
    procedure Break;
    inline
{$IFC Debugging}
        $A9FF;    {_Debugger}
{$ELSEC}
        $4E71;    {NOP}
{$ENDC}

implementation
    {It's all in the interface…}
end.